unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Windows, LMessages, Classes, SysUtils, FileUtil, Forms, Controls, Graphics,
  Dialogs, StdCtrls, ExtCtrls, Buttons, TMD.HookWinControl;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnHook: TButton;
    btnTest: TButton;
    btnUnHook: TButton;
    imgState: TImage;
    Label1: TLabel;
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    procedure btnHookClick(Sender: TObject);
    procedure btnUnHookClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Panel1Click(Sender: TObject);
  private
    FPrevWndProc: TWndProc;
    procedure TestWndMethod(var aMsg: TMessage);
    procedure DisplayIsHook(const aIsHook: boolean);
  public
    procedure Hook;
    procedure UnHook;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.DisplayIsHook(False);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FPrevWndProc) then
    Self.UnHook;
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin

end;

procedure TForm1.btnHookClick(Sender: TObject);
begin
  Self.Hook;
end;

procedure TForm1.btnUnHookClick(Sender: TObject);
begin
  Self.UnHook;
end;

procedure TForm1.TestWndMethod(var aMsg: TMessage);

  procedure Log(const aLog: string);
  begin
    memo1.Lines.Add(Concat(DateTimeToStr(now), ': ', aLog));
  end;

begin
  case aMsg.msg of
    // NC 系消息 在 lcl 的消息循环中无法触发

    WM_NCCREATE: Log('WM_NCCREATE');
    WM_NCDESTROY: Log('WM_NCDESTROY');
    LM_NCACTIVATE: log('LM_NCACTIVATE');
    LM_NCCALCSIZE: Log('LM_NCCALCSIZE');
    LM_NCHITTEST: Log('LM_NCHITTEST');
    LM_NCPAINT: Log('LM_NCPAINT');
    LM_MOUSEMOVE: Log('LM_MOUSEMOVE');
    LM_MOUSELEAVE: Log('LM_MOUSELEAVE');
    LM_MOUSEWHEEL: Log('LM_MOUSEWHEEL');
    LM_LBUTTONDBLCLK: Log('LM_LBUTTONDBLCLK');
    LM_LBUTTONDOWN: Log('LM_LBUTTONDOWN');
    LM_LBUTTONUP: Log('LM_LBUTTONUP');
    LM_KEYDOWN: Log('LM_KEYDOWN');
    LM_KEYUP: log('LM_KEYUP');
  end;

  // aMsg.Result:=1;
  aMsg.Result := FPrevWndProc(btnTest.Handle, aMsg.msg, aMsg.wParam, aMsg.lParam);
end;

procedure TForm1.DisplayIsHook(const aIsHook: boolean);
begin
  if aIsHook then
  begin
    btnHook.Enabled := False;
    btnUnHook.Enabled := True;
    imgState.Picture.LoadFromResourceName(HINSTANCE, 'ISHOOK');
    btnTest.Caption := '测试对象 [ Hook中... ]';
  end
  else
  begin
    btnHook.Enabled := True;
    btnUnHook.Enabled := False;
    imgState.Picture.LoadFromResourceName(HINSTANCE, 'NOTHOOK');
    btnTest.Caption := '测试对象 [ 未 Hook ]';
  end;
end;

procedure TForm1.Hook;
begin
  if TMD.HookWinControl.Hook(btnTest, @TestWndMethod, PWndProc(FPrevWndProc)) then
  begin
    Self.DisplayIsHook(True);
  end
  else
    ShowMessage('安装 Hook 失败!');
end;

procedure TForm1.UnHook;
begin
  if TMD.HookWinControl.UnHook(btnTest, FPrevWndProc) then
  begin
    Self.DisplayIsHook(False);
  end
  else
    ShowMessage('卸载 Hook 失败!');
end;

end.
